home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Memphis Amiga Group / MAG Disk (1989-11)(Memphis Amiga Group).zip / MAG Disk (1989-11)(Memphis Amiga Group).adf / HeadClean / hc_base < prev    next >
Text File  |  1986-11-06  |  3KB  |  113 lines
  1. \ Layout for HeadClean plus actual Cleaning words
  2. \
  3. \ Author: Phil Burk
  4. \ Copyright 1987,8,9 Phil Burk
  5. \
  6. \ This program is a freely redistributable shareware program.
  7.  
  8. ANEW TASK-HC_BASE
  9.  
  10. 80 constant NUMCYLS
  11.  
  12. \ Specify layout of window by defining constants
  13. 20 constant HC_BANNER_Y1
  14. 10 constant HC_LINE_HEIGHT
  15.  
  16. 50 constant  HC_SHOW_Y
  17.  
  18. 10 constant HC_GADGET_X
  19. hc_show_y 18 + constant HC_GADGET_Y
  20. 40 constant HC_GADGET_W
  21. 13 constant HC_GADGET_H
  22. 50 constant HC_GADGET_INC
  23.  
  24. 110 constant HC_MSG_Y
  25.  
  26. 440 constant HC_WINDOW_W
  27. 120 constant HC_WINDOW_H
  28. : HC_W_H hc_gadget_w hc_gadget_h ;
  29.  
  30. \ Output messages graphically in special area. ----------
  31. : HC.BLANK ( -- , clear message area )
  32.     2 gr.color!
  33.     10 hc_msg_y gr.move
  34.     5 hc_msg_y 12 - hc_window_w 10 - hc_msg_y 4 + gr.rect
  35. ;
  36.  
  37. : HC.TYPE  ( addr count -- , output some text )
  38.     gr-curwindow @
  39.     IF  1 gr.color!
  40.         JAM1 gr.mode!   \ don't clear background
  41.         gr.type
  42.     ELSE  \ just type it out if no window
  43.        type cr
  44.     THEN
  45. ;
  46.  
  47. : $HC.MSG ( $string -- , clear area & display message )
  48.     gr-curwindow @
  49.     IF hc.blank
  50.     THEN
  51.     count hc.type
  52. ;
  53.  
  54. \ --------------------------------------------------------
  55. \ This portion of the Code is concerned with actually
  56. \ cleaning the disk.
  57. variable CLEAN-DRIVE  ( which drive to clean 0,1,2,3 )
  58. variable CLEAN-START  ( which cylinder to start on )
  59. 4 constant CLEAN_#CYL ( # of cylinders to format each pass )
  60. 6 constant CLEAN_#PASSES
  61.  
  62. : DELAY() ( #ticks -- , wait )
  63.     1 max callvoid dos_lib delay
  64. ;
  65.  
  66. \ Format a band of cylinders several times.
  67. : CLEAN  ( start #cyl many -- ok? )
  68.     tdt.unformatted? not
  69.     IF " Warning - not a fibre cleaning disk in drive!!" $hc.msg
  70.        drop 2drop false
  71.     ELSE  0
  72.         DO  " Cylinders: " $hc.msg
  73.             2dup 0
  74.             DO dup i + n>text hc.type " ," count hc.type
  75.             LOOP drop
  76.             "  Pass: " count hc.type i n>text hc.type
  77. \
  78.             2dup tdt.format.cyl.many
  79.         LOOP 2drop true
  80.     THEN
  81. ;
  82.  
  83. : HC.REPORT.LEFT  ( -- , report how many cylinders are left )
  84.    " Cleaning disk has " $hc.msg
  85.    numcyls clean-start @ - clean_#cyl /  ( number of cleanings )
  86.    n>text hc.type
  87.    "  cleanings left." count hc.type
  88. ;
  89.  
  90. : HC.SETTLE ( #ticks -- , give disk time to settle )
  91.     10 / dup 0
  92.     DO  " Validating: " $hc.msg
  93.         dup i - n>text hc.type
  94.         10 delay()
  95.     LOOP drop
  96. ;
  97.  
  98. : <HEADCLEAN> ( -- ok? , clean based on variables )
  99.     200 hc.settle
  100.     clean-drive @ tdt.init 
  101.     IF  clean-start @
  102.         clean_#cyl
  103.         clean_#passes
  104.         clean
  105.         IF  clean_#cyl clean-start +!
  106.             hc.report.left true
  107.         ELSE false
  108.         THEN
  109.         tdt.term
  110.     ELSE " Error accessing that drive!" $hc.msg false
  111.     THEN
  112. ;        
  113.